home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / DELPHI32 / DATABASE / PROGRESS / STTDLG32.PAS < prev    next >
Pascal/Delphi Source File  |  1996-06-16  |  3KB  |  121 lines
  1. {
  2.  Unit Name:      SttDlg32
  3.  Unit Type:      Dialog
  4.  
  5.  Created:        18 December 1995
  6.  Last Modified:   1 June     1996
  7.  
  8.  Authors:        CNS International B.V.
  9.                  Feel free to use this unit as you like.
  10.  
  11.  Description: This dialog is an example of using the TDBProgress
  12.               component. To use this dialog, perform the following
  13.               actions:
  14.  
  15.               1. Add this file to your project
  16.               2. Add this unit to the 'uses' clause of the
  17.                  units which will be performing database actions
  18.               3. Place 'dlgStatus.Show;' before and 'dlgStatus.Hide;'
  19.                  after the database operations for which you want to
  20.                  provide feedback.
  21.               4. Compile and run.
  22.  }
  23.  
  24. unit SttDlg32;
  25.  
  26. interface
  27.  
  28. uses
  29.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  30.   Forms, Dialogs, StdCtrls, Buttons, Gauges, ExtCtrls, DB,
  31.   DBTables, Progrs32;
  32.  
  33. type
  34.   TdlgStatus = class(TForm)
  35.     panBackground: TPanel;
  36.     gauDBStatus: TGauge;
  37.     cmdAbort: TBitBtn;
  38.     DBProgress1: TDBProgress;
  39.     memTrace: TMemo;
  40.     procedure FormCreate(Sender: TObject);
  41.     procedure cmdAbortClick(Sender: TObject);
  42.     procedure DBProgress1StatusChange(Sender: TObject; var Abort: Boolean);
  43.     procedure DBProgress1CheckCancelQuery(Sender: TObject;
  44.       var Abort: Boolean);
  45.     procedure FormActivate(Sender: TObject);
  46.   private
  47.     { Private declarations }
  48.     bPerformAbort: Boolean;
  49.   public
  50.     { Public declarations }
  51.   end;
  52.  
  53. var
  54.   dlgStatus: TdlgStatus;
  55.  
  56. implementation
  57.  
  58. {$R *.DFM}
  59.  
  60. procedure TdlgStatus.FormCreate(Sender: TObject);
  61. begin
  62.    { Clear abort flag }
  63.    bPerformAbort := False;
  64. end;
  65.  
  66. procedure TdlgStatus.cmdAbortClick(Sender: TObject);
  67. begin
  68.    { Set the Abort flag to true }
  69.    bPerformAbort := True;
  70. end;
  71.  
  72.  
  73. procedure TdlgStatus.DBProgress1StatusChange(Sender: TObject;
  74.   var Abort: Boolean);
  75. begin
  76.    memTrace.Visible := False;
  77.    if DBProgress1.Percentage <> -1 then
  78.    begin
  79.       gauDBStatus.Visible := True;
  80.       gauDBStatus.Progress := DBProgress1.Percentage;
  81.    end
  82.    else
  83.    begin
  84.       gauDBStatus.Visible := False;
  85.       panBackground.Caption := DBProgress1.LastMessage;
  86.    end;
  87.    Abort := bPerformAbort;
  88.    { Reset abort flag after aborting }
  89.    if bPerformAbort then bPerformAbort := False;
  90.    { Make sure abort button can be pressed }
  91.    Application.ProcessMessages;
  92.  
  93. end;
  94.  
  95. procedure TdlgStatus.DBProgress1CheckCancelQuery(Sender: TObject;
  96.   var Abort: Boolean);
  97. begin
  98.    memTrace.Visible := False;
  99.    gauDBStatus.Visible := False;
  100.    panBackground.Caption := 'Processing Query...';
  101.  
  102.    Abort := bPerformAbort;
  103.    { Reset abort flag after aborting }
  104.    if bPerformAbort then bPerformAbort := False;
  105.  
  106.    { Check if I should hide myself }
  107.    if Abort then dlgStatus.Hide;
  108.  
  109.    { Make sure abort button can be pressed }
  110.    Application.ProcessMessages;
  111. end;
  112.  
  113. procedure TdlgStatus.FormActivate(Sender: TObject);
  114. begin
  115.    { Make sure the progress component is turned on }
  116.    DBProgress1.Activate;
  117.    Update;
  118. end;
  119.  
  120. end.
  121.